home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
BIMAIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
10KB
|
317 lines
UNIT BiMail;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ BiModem Mail Interface Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos;
PROCEDURE AddToTransferList(CONST FileName: STRING; InventName: BOOLEAN);
PROCEDURE WriteBiModemConfig(port: BYTE; Speed: WORD; CONST Path: PathStr);
PROCEDURE BiMailPostParse;
IMPLEMENTATION
USES OpString, OpCrt, OpDate,
Globals, PoPTypes, FileUtil, MailUtil, StrUtil, Com, LogFile, NetFile, SimpDB,
Util;
PROCEDURE AddToTransferList(CONST FileName: STRING; InventName: BOOLEAN);
VAR
f : FILE OF TBiModemTransfer;
b : TBiModemTransfer;
s : STRING;
BEGIN
ASSIGN(f,MakeTaskFileName('BIMODEM.PTH')); FileMode:=ShareRW+ShareDenyW;
RESET(f);
IF IORESULT<>0 THEN REWRITE(f) ELSE SEEK(f,FILESIZE(f));
FILLCHAR(b,SIZEOF(b),32);
Move(filename[1],b.source,Length(filename));
IF InventName THEN
BEGIN
s:=InventPktName;
Move(s[1],b.destination,length(s));
Pause(6);
END;
b.direction:='U';
WRITE(f,b);
CLOSE(f);
END;
PROCEDURE WriteBiModemConfig(port:BYTE; Speed:WORD; CONST Path: PathStr);
VAR
f : FILE OF TBiModemCfg;
c : TBiModemCfg;
s : String;
BEGIN
ASSIGN(f,MakeTaskFileName(PoPBimodemCfgFileName)); FileMode:=ShareRead+ShareDenyNone;
RESET(f);
IF IOResult<>0 THEN
BEGIN
ASSIGN(f,PoPBimodemCfgFileName); FileMode:=ShareRead+ShareDenyNone;
RESET(f);
END;
IF IOResult=0 THEN
BEGIN
READ(f,c);
Close(f);
END ELSE
FillChar(c,SizeOf(c),0);
c.MaxSize:=0; c.MaxTimeHour:=23; c.baudrate:=Speed;
c.comport:=port;
FillChar(c.defaultpathfile,SizeOf(c.defaultpathfile),32);
s:=MakeTaskFileName(Path+'bimodem.pth');
Move(s[1],c.DefaultPathFile,Length(s));
MkDir(Copy(Cfg.inbound[GlobNodeStat],1,Length(Cfg.Inbound[GlobNodeStat])-1)+'.ABT');
IF IOResult=0 THEN ;
s:=Copy(Cfg.inbound[GlobNodeStat],1,Length(Cfg.Inbound[GlobNodeStat])-1)+'.ABT\';
Move(s[1],c.AbortPath,Length(s));
FillChar(c.defaultreceive,SizeOf(c.defaultreceive),32);
Move(cfg.inbound[GlobNodeStat][1],c.defaultreceive,Length(Cfg.Inbound[GlobNodeStat]));
FillChar(c.RejectListPath,SizeOf(c.RejectListPath),' ');
c.BitMap1:=c.BitMap1 Or 144;
c.BitMap2:=c.BitMap2 Or 70;
c.UseCarrier:='Y';
c.WaitForConnect:=60;
c.CurDirAccess:='N'; c.RemoteFReq:='Y'; c.LocalFreq:='Y';
c.MaxErrPrFile:=0;
c.SkipIfSameDate:='Y';
Assign(f,MakeTaskFileName(PoPBimodemCfgFileName));
ReWrite(f); WRITE(f,c);CLOSE(f);
END;
PROCEDURE BiMailPostParse;
TYPE
TabType=ARRAY[1..200] OF String;
VAR
l : LongInt;
IsMail,IsReq : Boolean;
sr : SearchRec;
s,filename : String;
bf : FILE OF TBimodemInterComm;
b : TBiModemInterComm;
i,FileNum : Integer;
FileTab : ^TabType;
IftF : PTitFile;
Ift : TInboundFile;
Ext : S3;
PROCEDURE AddToList(CONST FNam: STRING);
BEGIN
INC(FileNum);
FileTab^[FileNum]:=StUpCase(FNam);
END;
FUNCTION FindFile(CONST FNam: STRING): BOOLEAN;
VAR
b:BOOLEAN;
i:INTEGER;
BEGIN
b:=FALSE;
IF FileNum>0 THEN
BEGIN
i:=0;
REPEAT
INC(i);
IF StUpCase(Fnam)=FileTab^[i] THEN b:=TRUE;
UNTIL (i=FileNum) OR b;
END;
FindFile:=b;
END;
PROCEDURE KillFLOfile(CONST ExtFlags : S5);
LABEL
next;
VAR
FName, HoldName : PathStr;
c, AkaNum : Byte;
fp : FILE;
s, SPtr : String;
Current, LastStart : LongInt;
i : Char;
SkippedOne, NoMoreAkas : Boolean;
Ch : Char;
OldAdr:TFidoAddress;
BEGIN
NoMoreAkas:=False; AkaNum:=0;
OldAdr:=Call;
REPEAT
HoldName:=HoldAreaPath(Call,False);
FOR c:=1 TO 5 DO
BEGIN
SkippedOne:=False;
FName:=HoldFileName(Call,False)+ExtFlags[c]+'LO';
Assign(fp, FName); FileMode:=ShareRW+ShareDenyW;
Reset(fp,1);
IF IoResult=0 THEN
BEGIN
Current:=0;
WHILE NOT EOF(fp) DO
BEGIN
LastStart:=Current;
ReadLine(fp,s);
SPtr:=s;
Current:=FilePos(fp);
IF SPtr[1]=TruncAfter THEN
BEGIN
SPtr:=Copy(SPtr, 2, Length(SPtr)-1);
i:=TruncAfter;
END ELSE
IF SPtr[1]=ShowDeleteAfter THEN
BEGIN
SPtr:=Copy(SPtr, 2, Length(SPtr)-1);
i:=ShowDeleteAfter;
END ELSE
i:=NothingAfter;
IF Length(SPtr)=0 THEN GOTO next;
IF SPtr[1] <> '~' THEN
BEGIN
IF FindFile(SPtr) THEN
BEGIN
Seek(fp, LastStart);
Ch:=#126;
BlockWrite(fp, Ch, 1);
Seek(fp, Current);
END ELSE
BEGIN
SkippedOne:=True;
Goto Next;
END;
IF i=TruncAfter THEN
BEGIN
TruncateFile(SPtr);
AddLog('#', 'Flagging ' + SPtr + ' as sent');
END ELSE
IF i=ShowDeleteAfter THEN
BEGIN
DeleteFile(SPtr);
AddLog('#', 'Unlinking ' + SPtr);
END ELSE
IF i=DeleteAfter THEN DeleteFile(SPtr);
END;
next:
END; { While }
Close(fp);
IF Not SkippedOne THEN DeleteFile(FName);
END; { Not found }
END; { For }
Inc(AkaNum);
IF (AkaNum<=MaxAddresses) And (RemAka[AkaNum].Zone<>0) THEN
BEGIN
Call:=RemAka[AkaNum];
END ELSE
NoMoreAkas:=True;
UNTIL NoMoreAkas ;
Call:=OldAdr;
END;
BEGIN
FileNum:=0;
New(FileTab);
ASSIGN(bf, MaketaskFileName(PoPBiModemInterComLog)); FileMode:=ShareRead+ShareDenyW;
RESET(bf);
IF IOResult=0 THEN
BEGIN
WHILE NOT EOF(bf) DO
BEGIN
READ(bf,b);
FileName:=StUpCase(AsciiZ2Str(b.filepath,78));
IF (b.status<>'A') THEN
BEGIN
findfirst(filename,AnyFile,sr);
FindClose(Sr);
AddLog('+', 'CPS: '+Long2Str(b.cps DIV 10)+' ('+Long2Str(sr.size)+' bytes) Efficiency '+
Form('#,###.#',b.cps/ComPort^.GetBaudRate*100)+'%');
CASE b.direction OF
'R' : BEGIN
Inc(FReceived);
AddLog('+', 'Received-B '+FileName);
s:=StUpCase(JustFileName(FileName));
IsMail:=FALSE;
IsReq:=FALSE;
i:=POS('.',s);
IF i>0 THEN
BEGIN
Ext:=COPY(s,i+1,3);
IF LENGTH(s)=12 THEN
BEGIN
VAL('$'+COPY(s,1,8),l,i);
IF i=0 THEN
BEGIN
IF (Ext='PKT') THEN IsMail:=TRUE ELSE
IF (Ext='R'+HexB(Cfg.TaskNumber)) OR (Ext='PTF') THEN
IsReq:=TRUE
ELSE
IF (Ext[3] IN ['0'..'9']) THEN
BEGIN
DEC(Ext[0]);
IF (POS(Ext,'MO*TU*WE*TH*FR*SA*SU')>0) THEN IsMail:=TRUE;
END;
END ELSE
IF (Ext='TIC') AND (Copy(s,1,2)='TK') THEN IsReq:=True;
END;
END;
IF (NOT IsReq) AND IsMail THEN GotSomeMail:=TRUE ELSE
BEGIN
GotSomeFiles:=TRUE;
IF NOT IsReq THEN
BEGIN
FILLCHAR(Ift,SizeOf(Ift),0);
WITH Ift DO
BEGIN
FileName:=JustName(s);
RecvTime:=CurrentTime;
RecvDate:=Today;
From:=RemHello.Address;
TaskNum:=Cfg.TaskNumber;
END;
New(IftF, Open(True));
IF IftF<>NIL THEN
BEGIN
IftF^.AddRec(Ift);
Dispose(IftF, Close);
END ELSE
AddLog('!', 'Not enough memory to open: PORTAL.TIT');
END;
END;
END;
'S' : BEGIN
INC(FSent);
AddLog('+', 'Sent-B '+FileName);
s:=StUpCase(AddBackSlash(Cfg.Outbound));
s:=Copy(s,1,Length(s)-1);
IF (s=COPY(filename,1,Length(s))) AND ((COPY(filename,Length(filename)-1,2)='UT')
OR ((COPY(filename,Length(filename)-2,3)='RSP'))) THEN
BEGIN
IF DeleteFile(filename) THEN AddLog('#','Unlinking '+FileName);
END ELSE AddToList(FileName);
END;
END;
END;
END;
CLOSE(bf);
INC(StatRec^.DayStat[0].FilesIn, FReceived);
INC(StatRec^.DayStat[0].FilesOut, FSent);
DeleteFile(MaketaskFileName(PoPBiModemInterComLog));
END;
ExtFlags[3]:='F';
KillFloFile(ExtFlags);
DeleteFile(MakeTaskFileName('BIMODEM.PTH'));
Dispose(FileTab);
END;
END.